; 4-7 binary search tree; 

(defstruct (node (:print-function
									 (lambda (n s d)
										 (format s "#<~A>" (node-elt n)))))
	elt (l nil) (r nil))

; 插入二叉树
(defun bst-insert (obj bst <)
	(if (null bst)
		(make-node :elt obj)
		(let ((elt (node-elt bst)))
			(if (eql obj elt)
				bst
				(if (funcall < obj elt)
					(make-node
						:elt elt
						:l (bst-insert obj (node-l bst) <)
						:r (node-r bst))
					(make-node
						:elt elt
						:l (node-l bst)
						:r (bst-insert obj (node-r bst) <)))))))

; 查找二叉树
(defun bst-find (obj bst <)
  (if (null bst)
    nil
    (let ((elt (node-elt bst)))
      (if (eql obj elt)
        bst
        (if (funcall < obj elt)
          (bst-find obj (node-l bst) <)
          (bst-find obj (node-r bst) <))))))

; 二叉树中最大元素
(defun bst-min (bst)
  (and bst
       (or (bst-min (node-l bst)) bst)))

; 二叉树中最小元素
(defun bst-max (bst)
  (and bst
       (or (bst-max (node-r bst)) bst)))

; 移除二叉树中的元素
(defun bst-remove (obj bst <)
	(if (null bst)
		nil
		(let ((elt (node-elt bst)))
			(if (eql obj elt)
				(percolate bst)
				(if (funcall < obj elt)
					(make-node
						:elt elt
						:l (bst-remove obj (node-l bst) <)
						:r (node-r bst))
					(make-node
						:elt elt
						:r (bst-remove obj (node-r bst) <)
						:l (node-l bst)))))))

(defun percolate (bst)
	(cond ((null (node-l bst))
				 (if (null (node-r bst))
					 NIL
					 (rperc bst)))
				((null (node-r bst))
				 (lperc bst))
				(t (if (zerop (random 2))
						 (lperc bst)
						 (rperc bst)))))

(defun rperc (bst)
	(make-node :elt (node-elt (node-r bst))
						 :l (node-l bst)
						 :r (percolate (node-r bst))))

(defun lperc (bst)
	(make-node :elt (node-elt (node-l bst))
						 :l (percolate (node-l bst))
						 :r (node-r bst)))

(defun bst-traverse (fn bst)
	(when bst
		(bst-traverse fn (node-l bst))
		(funcall fn (node-elt bst))
		(bst-traverse fn (node-r bst))))

(setf L '(5 8 4 2 1 0 6 7 3))
